perm filename M11A.F4[P11,LCS]2 blob sn#347641 filedate 1978-04-13 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	CPASS3     PASS 3 MAIN PROGRAM  
C00013 ENDMK
CāŠ—;
CPASS3     PASS 3 MAIN PROGRAM  
C    *** MUSIC V ***     
C     DATA SPECIFICATION 
      INTEGER PEAK
      DIMENSION T(50),TI(50),ITI(50)   
      COMMON I(4000) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,NRSOR,IPEAK
	COMMON /INS/INS(400),IDEF(100) /NT/NT(1000) /IOUT/IOUT(512)
C    INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, IOUT=OUTPUT BLOCK
	EQUIVALENCE (IP9,IP(9)),(I2,I(2)),(I6,I(6)),(I5,I(5)),(T3,T(3))
	1,(T2,T(2)),(P3,P(3))
CC*******      DATA IIIRD/Z5EECE66D/     
      DATA IIIRD/976545367/     
C  SET I ARRAY =0 (7/10/69)
      DATA I/4000*0/,I(4)/12800/
C**************
C     INIALIZATION OF PIECE     
C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
      I(7)=IIIRD  
 
C****** SEE BLOCK DATA RE. SCALE FACTORS *********   IP(12)=2**8

      PEAK=0      
      NRSOR=0     
	IPEAK=0
C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
CC*******    NREAD = 3   
CC*******    NWRITE = 2  
      NREAD=21
C   PDP DSK1=DEV.21
      NWRITE=1
C   PDP DSK=DEV.1
      REWIND NREAD
      REWIND NWRITE      
      TYPE 401  
      ACCEPT 501  ,FLNM,IDSK
C  TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
      IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
      CALL IFILE(21,FLNM)
      IF(IDSK.NE.0)GO TO 601
	CALL OFILE(23,'TEST')
	GO TO 701
401   FORMAT(' TYPE FILE NAME'/)
501   FORMAT(A5,I)
601   IDSK=-1
701   SCLFT=IP(12)
      I2=1      
CC    I(2)=IP(4)  
CC    MS1=IP(7)   
	MS1=1
      MS3=MS1+(IP(8)*IP9)-1   
      MS2=IP(8)   
      I(4)=IP(3)  
      MOUT=1      
CC    MOUT=IP(10) 
C     INITIALIZATION OF SECTION 
5     T(1)=0.0    
      DO 220 N1=MS1,MS3,MS2
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
 220  NT(N1)=-1    
      DO 221N1=1,IP9      
 221  TI(N1)=90909.  
C     MAIN CARD READING LOOP    
  204 CALL DATA (NREAD)  
      IF(P(2)-T(1))200,200,244  
 200  IOP=P(1)    
      IF(IOP)201,201,202 
 201  CALLERROR(1)
      GO TO 204     
 202  IF(IP(1)-IOP)201,203,203  
 203  GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP    
 11   IVAR=P3   
      IVARE=IVAR+I(1)-4  
      DO  297 N1=IVAR,IVARE      
      IVARP=N1-IVAR+4    
 297  NT(N1)=P(IVARP)     
      GO TO 204     
 3    IGEN=P3   
      IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION  GO TO (281,282,283,284,285),IGEN   
 281  CALLGEN1    
      GO TO 204     
 282  IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
      CALLGEN2    
      GO TO 204     
CCC 283  CALLGEN3    
CCC   GO TO 204     
CCC 284  CALLGEN4    
CCC   GO TO 204     
CCC 285  CALLGEN5    
CCC   GO TO 204     
 4    IVAR=P3   
      IVARE=IVAR+I(1)-4  
      DO 296N1=IVAR,IVARE 
      IVARP=N1-IVAR+4    
 296  I(N1+100)=P(IVARP)*SCLFT  
      GO TO 204     
    6 CALL FROUT3(IDSK)
      STOP 
C     ENTER NOTE TO BE PLAYED   
 1    DO 230N1=MS1,MS3,MS2
230   IF(NT(N1).EQ.-1)GO TO 231      
      CALLERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
	TYPE 1230,IP(9)
      GO TO 204     
1230	FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
 231  M1=N1
      M2=N1+I(1)-1
      M3=M2+1     
      M4=N1+IP(8)-1      
      DO 232N1=M1,M2      
      M5=N1-M1+1  
 232  NT(N1)=P(M5)*SCLFT  
      NT(M1  )=P3
      DO 233N1=M3,M4      
 233  NT(N1)=0     
      DO 235N1=1,IP9      
      IF(TI(N1)-90909.)235,234,235   
 234  TI(N1)=P(2)+P(4)   
      ITI(N1)=M1  
      GO TO 204     
 235  CONTINUE    
      CALLERROR(3)
      GO TO 204     
C     DEFINE INSTRUMENT  
 2    M1=I2     
CQQ   M2=IP(5)+IFIX(P3)
      M2=IFIX(P3)
      I(M2)=M1    
  218 CALL DATA (NREAD)  
      IF(I(1)-2)210,210,211     
 210  INS(M1)=0     
      I2=M1+1   
      GO TO 204     
 211  INS(M1)=P3  
      M3=I(1)     
      INS(M1+1)=M1+M3-1    
      M1=M1+2     
      DO 217N1=4,M3
      M5=P(N1)    
      IF(M5)212,213,213  
 212  IF(M5+100)300,301,301     
 300  INS(M1)=-IP(2)+(M5+101)*IP(6)      
      GO TO 216     
 301  INS(M1)=-1+(M5+1)*IP(14)      
CC301  I(M1)=-IP(13)+(M5+1)*IP(14)      
      GO TO 216     
 213  IF(M5- 100 )214,214,215   
 214  INS(M1)=M5    
      GO TO 216     
 215  INS(M1)=M5+26262     
CCC215	I(M1)=M5+262144    
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
 216  M1=M1+1     
 217  CONTINUE    
      GO TO 218     
C     PLAY TO ACTION TIME
 244  T2=P(2)   
 250  TMIN=90909.    
      IREST=1     
      DO 241N1=1,IP9      
      IF(TMIN-TI(N1))241,241,240
 240  TMIN=TI(N1) 
      MNOTE=N1    
 241  CONTINUE    
      IF(90909.-TMIN)251,251,243     
 243  IF(TMIN-T2)245,245,246  
 245  T3=TMIN   
      GO TO 260     
 246  T3=T2   
      GO TO 260     
 247  IF(T(1)-T2)249,200,200  
 249  TI(MNOTE)=90909.
      M2=ITI(MNOTE)      
      I(M2)=-1    
      GO TO 250     
C     SETUP REST  
 251  T3=T2   
      IREST=2     
      GO TO 260     
C     PLAY 
 260  ISAM=(T3-T(1))*FLOAT(I(4))+.5  
      T(1)=T3   
      IF(ISAM)247,247,266
 266  IF(ISAM-IP(14))262,262,263
 262  I5=ISAM   
      ISAM=0      
      GO TO 264     
 263  I5=IP(14) 
      ISAM=ISAM-IP(14)   
 264  IF(I(8))290,290,291
 290  M3=MOUT+I5-1     
      MSAMP=I5  
      GO TO 292     
 291  M3=MOUT+(2*I5)-1 
      MSAMP=2*I5
 292  DO 267N1=MOUT,M3    
 267  IOUT(N1)=0     
      GO TO (268,265),IREST
 268  DO 270NS1=MS1,MS3,MS2      
      IF(NT(NS1)+1)271,270,271   
C     GO THROUGH UNIT GENERATORS IN INSTRUMENT
 271  I(3)=NS1    
      IGEN=1+NT(NS1)  
CC    IGEN=IP(5)+I(NS1)  
      IGEN=NT(IGEN)
 272  I6=IGEN   
CC*****    IF(I(IGEN)-101)293,294,294
CC***** 293  CALLSAMGEN(I)      
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC*****      GO TO 295     
 294  CALLFORSAM  
 295  IGEN=NT(IGEN+1)     
      IF(NT(IGEN))270,270,272    
 270  CONTINUE    
 265  CALL SAMOUT(IDSK ,MSAMP)
      IF(ISAM)247,247,266
      END